PC-Blue - MS DOS Public Domain Library

home *** CD-ROM | disk | FTP | other *** search

/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol045 / rbbspc.bas < prev next >

Wrap

BASIC Source File | 1987-01-11 | 57.0 KB | 1,095 lines

1 ' *********************************************************************** 10 'RBBS-PC.BAS Remote Bulletin Board Program CPC09 20 'Original author - Russ Lane - 6/21/82 - (C)Copyright 1982 30 'Revised by Brad Hanson 3,4,5 & 6/83 - Copyright (c) 1983 40 ' CIS 72115,22 45 ' 46 'Capital PC RBBS-PC enhancement version CPC09: 47 ' 49 ' CPC01,2,3,5,6,7,8 & 09 Revised by Larry Jordan 50 ' 4-7/83 - Copyright (c) 1983 51 ' CPC03,4,5 & 8 Revised by Gary Horwith 5-6/83 - Copyright (c) 1983 52 ' CPC04 Revised by Rich Schinnell 5/83 - Copyright (c) 1983 55 ' CPC01 Revised by Jim Fry 5/83 - Copyright (c) 1983 60 ' CPC01,4,7 Revised by Scott Loftesness 5-6/83 61 ' CPC09 Revised by David Sykes 7/83 65 ' CPC09 May be distributed for non-commercial purposes only. 67 ' CPC09 No fee may be charged for distributing this program. 69 ' CPC09 Please distribute changes ONLY AS CHANGE FILES. 70 ' Do NOT distribute modified copies of this program! 74 ' 75 ' For Hayes Smartmodem 300 or 1200 .. Switch settings UUDDDUUD 80 ' 12345678 85 ' 86 ' This RBBS requires DOS 2.0 and BASICA 2.0! 87 ' 89 ' *********************************************************************** 90 CLOSE:OPEN "COM1:1200,E,7,1,CS,DS,CD" AS 3:MODEMDTR=INP(&H3FC):OUT &H3FC,&H0:OUT &H3FC,MODEMDTR:PRINT #3,"ATZ":CLOSE 94 CLEAR:VERSION$="CPC09" 95 WIDTH 80:SCREEN 0,0,0:KEY OFF:SYSOPNEXT=0:FGR=7:BGR=0:BDR=0:COLOR FGR,BGR,BDR:CLS 100 DATA MESSAGES,"MESSAGES.BAK",HELP01,HELP02,HELP03,HELP04,HELP05,HELP06,HELP07,BB,A,DIR,MDIR,CALLERS,BULLETIN,WELCOME,USERS,LASTCALR,LONGCALR,COMMENTS,NEWUSER,pass,word,firstname,lastname,0 101 'Relace in above data the remote access name you will use as sysop where you see "pass" and "word" and put your real name where you see "firstname" and "lastname". Use all caps. 102 'Change last number to number of rings before answer. See also line 240 103 Y=FRE(""):TI$=TIME$ 104 ON ERROR GOTO 13000:DEF SEG 105 ON KEY(1) GOSUB 31000:KEY(1) ON 106 ON KEY(2) GOSUB 32000:KEY(2) ON 107 ON KEY(3) GOSUB 33000:KEY(3) ON 108 ON KEY(4) GOSUB 33040:KEY(4) ON 109 ON KEY(7) GOSUB 15000:KEY(7) ON ' KEY 7 - Hold system for SYSOP next 110 'ON KEY(6) 111 'ON KEY(7) 112 'ON KEY(8) 113 ON KEY(9) GOSUB 39000:KEY(9) ON 114 ON KEY(10) GOSUB 30000:KEY(10) ON 115 DEFINT A-Z:CR$=CHR$(13):LF$=CHR$(10):ABT$=CHR$(11):PL=23 117 DATA BULLET1,BULLET2,BULLET3,BULLET4,BULLET5,BULLET6 120 READ MESSAGES$,MESSAGES.BAK$,HELP01$,HELP02$,HELP03$,HELP04$,HELP05$,HELP06$,HELP07$,FDEV$,RDEV$,DIR$,MDIR$,CALLERS$,BULLETIN$,WELCOME$,USERS$,R$,LONGCALR$,COMMENTS$,NEWUSER$,PASS1$,PASS2$,NFIR$,NLAS$,CBACK 121 READ BULLET1$,BULLET2$,BULLET3$,BULLET4$,BULLET5$,BULLET6$ 123 FOR I=1 TO 10:KEY I,"":NEXT I:LOCATE ,,1 125 BK$=CHR$(8)+CHR$(32)+CHR$(8):BK1$=CHR$(29)+CHR$(32)+CHR$(29) 126 CR$=CHR$(13):LF$=CHR$(10):ABT$=CHR$(11):SNOOP$=CHR$(0)+CHR$(105) 127 TIME.MAX!=45*60:MARGIN=72:ERR.COUNT=0:ERR.MAX=10:TIME.OUT!=3*60:MESSAGE.MAX=250:LAPSE.MAX=1:TSCRN.MAX=120 128 RDEV$=RDEV$+":":MESSAGES$=RDEV$+MESSAGES$:CALLERS$=RDEV$+CALLERS$:USERS$=RDEV$+USERS$:LONGCALR$=RDEV$+LONGCALR$:COMMENTS$=RDEV$+COMMENTS$:MESSAGES.BAK$=RDEV$+MESSAGES.BAK$ 130 DIM M(MESSAGE.MAX,2),A$(30),B$(10),C$(30):GOSUB 135:GOTO 175 135 'Write Record #, Msg #, to Array ------------- 140 CLOSE #1,2:LASTR=0:R=2:OPEN "R",#1,MESSAGES$:FIELD #1,128 AS R$ 145 IF LOF(1)=0 THEN LSET R$=" 1 -1 0":PUT 1 ELSE GET 1 147 LASTM=VAL(LEFT$(R$,8)):AVAILABLE=VAL(MID$(R$,9,2)) 150 GET 1,R:IF MID$(R$,116,1)=CHR$(226) THEN DEAD=-1 155 RR=VAL(MID$(R$,118)):IF DEAD THEN 165 ELSE IF RR<1 THEN 170 160 LASTR=LASTR+1:M(LASTR,1)=R:M(LASTR,2)=VAL(MID$(R$,2,4)) 165 R=R+RR:DEAD=0:GOTO 150 170 FIRSTM=M(1,2):RETURN 175 SOH$=CHR$(1):EOT$=CHR$(4):ACK$=CHR$(6):NAK$=CHR$(21):CAN$=CHR$(24):ESC$=CHR$(27):STP$=CHR$(0)+CHR$(112) 180 GOSUB 21600:BPS=&H180:NBPS=&H100:FALSE=0:TRUE=NOT FALSE 181 AVAILABLE=TRUE 182 BIT.8=FALSE:PRT=FALSE:LPRT=FALSE:ONLINE=FALSE:ANNOY=TRUE :ANNOY.ON=800:ANNOY.OFF=2200 183 PRINT "RBBS-PC Version ";VERSION$:PRINT "Free memory: ";FRE("A") 187 IF LPRT THEN GOSUB 480:LPRINT :LPRINT :LPRINT "RBBS-PC Version ";VERSION$;" up at " TIM$ " on " DATE$:GOSUB 50500 189 PRINT:PRINT "Enter:":PRINT " <ESC> for sysop sign-on maintenance/page.":PRINT " <F1> to return to DOS.":PRINT " <F2> to return to BASIC." 191 PRINT " <F3> to toggle Line Printer on/off.":PRINT " <F4> to toggle SYSOP Page Bell on/off." 193 PRINT " <F5> Unassigned.":PRINT " <F6> Unassigned." 194 PRINT " <F7> SYSOP gets system after this caller":PRINT " <F8> Unassigned." 195 PRINT " <F9> to toggle SNOOP on/off.":PRINT " <F10> to force CHAT and <ESC> to end." 200 'Wait for Caller to Call --------------------- 210 OPEN "COM1:1200,E,7,1,RS,CD,DS0" AS #3:FOR X=1 TO 3:PRINT #3,CHR$(13);:SOUND 32767,18:NEXT 215 ' 220 PRINT #3,"ATQ1 S4=13 S5=130 S10=20 S0=255 S1?":INPUT #3,X$ 225 GOSUB 480 230 PRINT:PRINT "RBBS-PC is ready for calls at " TIM$ " on " DATE$ 231 PRINT:PRINT"<< Screen will clear after time delay to prevent burn-in of display. >>":PRINT:IF NOT PRT THEN LOCATE ,,0 235 TSCRN!=TIMER 240 RB=2:X=1:WHILE (INP(&H3FE) AND &H40)=0 250 X$=INKEY$:IF X$=CHR$(27) THEN LOCATE 24,1:PRINT "Sysop is in.":CLOSE 3:LOCAL=-1:GOTO 470 ELSE IF X$=STP$ THEN SYSTEM 260 IF RB THEN RB=RB-1:IF (RB=0 AND PRT AND CBACK<>0) THEN PRINT "Ringback timeout" 265 X=0:MMM!=TIMER-TSCRN!:IF MMM!>TSCRN.MAX THEN LOCATE ,,0:CLS:TSCRN!=TIMER 270 WEND:IF CBACK=0 THEN 320 275 WHILE (INP(&H3FE) AND &H40) 276 IF PRT THEN SOUND 3000,1:SOUND 4000,2:SOUND 32767,6 277 WEND:IF LOC(3) THEN X$=INPUT$(LOC(3),3) 280 PRINT #3,"ATS1?" 290 INPUT #3,X$:IF LEN(X$)=0 THEN 290 ELSE IF PRT THEN PRINT "Ring ";X$ 300 IF RB AND (VAL(X$)<=X) AND (VAL(X$)<>0) THEN 320 ELSE X=VAL(X$) 310 IF X<CBACK THEN 240 320 CLOSE 3:OPEN"COM1:1200,E,7,1,RS,CD,DS0" AS 3:PRINT #3,"ATA":CLOSE 3 325 OPEN "COM1:300,E,7,1,CD,DS,CS" AS 3 330 Q=&H180:QQ=&H60:IF PRT THEN LOCATE ,,1 331 FOR JJ=1 TO 600:SOUND 32767,1:IF INP(&H3FE)>127 THEN 333 332 NEXT JJ:RUN 333 GOSUB 21280:GOSUB 50500:OUT &H3FB,&H3:BIT.8=TRUE 335 IF INP(&H3FE)<128 THEN RUN ELSE IF EOF(3) THEN 335 340 A=0:A=ASC(INPUT$(LOC(3),3)):IF A=13 THEN GOTO 350 ELSE IF A=141 THEN OUT &H3FB,&H1A:BIT.8=FALSE:GOTO 350 345 SWAP Q,QQ:CALL BAUDS(Q):OUT &H3FB,&H3:BIT.8=TRUE:GOTO 335 350 I=0:GOSUB 480:IF Q=&H60 THEN BPS=TRUE ELSE BPS=FALSE 355 TIMER OFF:ON TIMER(10*60) GOSUB 42000:TIMER ON:TI!=TIMER:ONLINE=TRUE:GOSUB 21280 360 LF=-1:UC=0:PRINT #3,LF$:PRINT #3,"CAN YOUR TERMINAL DISPLAY LOWER CASE";:GOSUB 1500:Z$=B$(1):GOSUB 5000:PRINT #3,"" 364 IF BIT.8 THEN PARMS$="NO PARITY, 8 DATA BITS, 1 STOP BIT." ELSE PARMS$="EVEN PARITY, 7 DATA BITS, 1 STOP BIT." 365 IF BPS THEN BAUD$="1200 BAUD, " ELSE BAUD$="300 BAUD, " 366 A$="RBBS-PC VERSION "+VERSION$:GOSUB 1400:A$=LF$+"OPERATING AT "+BAUD$+PARMS$ 367 CR=2:GOSUB 1400 370 IF NO THEN UC=-1 ELSE IF NOT YES THEN 360 380 CR=0:STI=-1:FILE$=WELCOME$:GOSUB 6000 385 A$="Do you wish to skip system bulletins":GOSUB 1500:IF YES THEN GOTO 395 390 FILE$=BULLETIN$:GOSUB 6000:GOSUB 9700 395 CR=2:STI=0:GOSUB 1400:TRIES=0 400 'Get Caller's Name --------------------------- 405 IF TRIES>5 THEN RUN 410 TRIES=TRIES+1:GOSUB 1400:A$="What is your FIRST Name":GOSUB 1500 415 IF Q=0 THEN 400 ELSE Z$=B$(1):GOSUB 5000:FIRST$=Z$:IF Q=1 THEN 425 420 Z$=B$(2):GOTO 430 425 A$=" And your LAST Name":GOSUB 1500:Z$=B$(1) 430 GOSUB 5000:LAST$=Z$ 435 IF LEN(FIRST$)<2 OR LEN(LAST$)<2 THEN 400 440 IF FIRST$=PASS1$ AND LAST$=PASS2$ THEN 470 445 NAM$=MID$(FIRST$+" "+LAST$,1,31) 450 IF INSTR(NAM$,"SYSOP")OR INSTR(NAM$,NFIR$+" "+NLAS$)THEN 10620 455 FOR J=1 TO LEN(NAM$) 460 X=ASC(MID$(NAM$,J,1)):IF (X<65 OR X>90) AND (X<>32 AND X<>39 AND X<>45 AND X<>46) THEN 400 465 NEXT:GOTO 500 469 ' 470 FIRST$=NFIR$:LAST$=NLAS$:NAM$="SYSOP":SYSOP=-1:PRT=TRUE:BELL=0:XPR=0:MARGIN=72:GOSUB 480:IF LOCAL THEN 900 ELSE GOTO 835 480 TI$=TIME$:D$=LEFT$(DATE$,6)+RIGHT$(DATE$,2) 482 TIM$=TIME$:IF VAL(LEFT$(TIM$,2))>12 THEN MID$(TIM$,1,2)=RIGHT$(STR$(VAL(LEFT$(TIM$,2))-12),2):TIM$=LEFT$(TIM$,5)+" PM":RETURN ELSE TIM$=LEFT$(TIM$,5)+" AM":RETURN 500 'Check Last Caller --------------------------- 505 ' 510 A$="Checking User File...":CR=2:GOSUB 1400 520 GET 1,1:IF NAM$<>MID$(R$,21,LEN(NAM$)) THEN 600 540 LASTCALR=-1:A$="Welcome back, "+FIRST$+".":GOSUB 1400 600 'Check User File ----------------------------- 610 GOSUB 9400:X$=NAM$+SPACE$(31-LEN(NAM$)):UIX#=0 615 GET 2:IF EOF(2) THEN 700 ELSE IF ASC(N$)=0 THEN UIX#=LOC(2):GOTO 615 620 IF X$<>N$ THEN 615 ELSE IF ST$<>"Y" THEN 10640 ELSE UIX#=LOC(2) 625 I=0:IF Q=3 THEN Z$=B$(3):GOTO 635 630 GOSUB 1400:A$="Password (dots will echo) ":SECURE=-1:GOSUB 1500:SECURE=NOT SECURE:Z$=B$(1) 635 IF LEN(Z$)>15 THEN 630 ELSE GOSUB 5000:Z$=Z$+SPACE$(15-LEN(Z$)) 640 IF Z$<>PW$ THEN I=I+1:IF I<4 THEN 630 ELSE RUN 645 NEWCALR=0:GOTO 800 700 'Get New User's Background ------------------- 705 NEWCALR=-1:IF UIX# THEN GET 2,UIX# ELSE UIX#=LOC(2) 710 A$="What type of system are you calling from":GOSUB 1500:IF Q=0 THEN 400 ELSE LSET MA$=B$(1) 715 A$="What CITY and STATE are you calling from":GOSUB 1500 720 IF Q=0 THEN 400 ELSE Z$=B$(1):GOSUB 5000 735 A$=NAM$+" from "+Z$:GOSUB 1400 745 A$="Is this correct":GOSUB 1500:GOSUB 1400:IF NOT YES THEN 400 ELSE LSET CS$=Z$ 750 A$="Type in a message security PASSWORD (not IBMPC) ":GOSUB 1500:IF Q=0 THEN 750 ELSE IF LEN(B$(1))>15 THEN A$="15 Char. max":GOSUB 1400:GOTO 750 ELSE Z$=B$(1):GOSUB 5000 755 A$="Type in PASSWORD again for security double check":SECURE=-1:GOSUB 1500:SECURE=0:GOSUB 1400:SWAP Z$,B$(1):GOSUB 5000:IF B$(1)<>Z$ THEN A$="Passwords don't match, start over !":GOSUB 1400:GOTO 750 760 GOSUB 5000:LSET PW$=Z$:GOSUB 1400:A$=FIRST$+", please remember your password for the next time you call.":CR=2:GOSUB 1400:LSET N$=NAM$:LSET ST$="Y" 765 LSET N$=NAM$:LSET ST$="Y":LSET OP$=MKI$(0)+MKI$(0)+MKI$(-1)+MKI$(64)+STRING$(4,0)+CHR$(PL)+STRING$(2,0) 770 ' 800 'Log To Disk --------------------------------- 805 GOSUB 1400:A$="Logging "+NAM$+" to disk...":GOSUB 1400 810 TIMON=CVI(MID$(OP$,1,2))+1:LMSG=CVI(MID$(OP$,3,2)):LF=CVI(MID$(OP$,5,2)):MARGIN=CVI(MID$(OP$,7,2)):BELL=CVI(MID$(OP$,9,2)):XPR=CVI(MID$(OP$,11,2)):PL=ASC(MID$(OP$,13)) 812 IF LMSG>LASTM THEN LMSG=0 815 LSET OP$=MKI$(TIMON)+MID$(OP$,3):LSET TD$=D$+" "+TI$:PUT 2,UIX# 820 IF NOT NEWCALR THEN A$="You have signed on"+STR$(TIMON)+" times.":CR=2:GOSUB 1400 835 CLOSE 2:OPEN "A",2,CALLERS$ 836 IF BIT.8 THEN PARMS$="N,8,1" ELSE PARMS$="E,7,1" 837 Z$=NAM$+" on at "+D$+", "+TIM$+" -- "+BAUD$+PARMS$ 840 PRINT #2,Z$:CLOSE 2:IF LPRT THEN LPRINT " "+Z$ 845 IF LASTCALR THEN 945 900 'Search for any messages to this caller ------ 905 A$="":GOSUB 1400:A$="Checking message file...":CR=2:IF NOT LOCAL THEN GOSUB 1400 910 X=37:Y=31:F$=NAM$:T=0:DONE=0:R=1 915 FOR R=1 TO LASTR 920 GET 1,M(R,1):IF INSTR(MID$(R$,37,31),NAM$)=0 THEN 940 ELSE IF T THEN 935 925 A$="The following message(s) may be for you.":GOSUB 1400 930 A$="Please <K>ill those that would not interest other callers.":CR=2:GOSUB 1400:T=-1 935 A$=LEFT$(R$,5):CR=1:GOSUB 1400:GOTO 940 940 NEXT 942 IF NOT T THEN A$="Sorry, "+FIRST$+", no personal mail for you today.":GOSUB 1400 945 CR=2:GOSUB 1400:FIELD 1,10 AS A$,10 AS Y$,31 AS A$:GET 1,1:CALLN=VAL(Y$)+1 946 IF NOT SYSOP THEN LSET A$=NAM$:LSET Y$=STR$(CALLN):PUT 1,1 948 A$="Entering the message subsystem...":GOSUB 1400 950 IF PRT THEN LOCATE 25,1:PRINT SPACE$(80-(LEN(NAM$)+11));NAM$" "TIM$ 955 GOSUB 4900:STI=-1:IF NEWCALR THEN FILE$=NEWUSER$:GOSUB 6000:GOSUB 1700 1200 'Command Dispatcher ------------------ 1210 STI=-1:Q=0 1220 GOSUB 1400 1230 IF NOT SYSOP THEN 1235 1231 IF XPR THEN A$="Sysop <1,2,3,4,5,6,7,8,9,10>":GOSUB 1400:ELSE GOSUB 10000 1232 GOTO 1240 1235 GOSUB 1400:GOSUB 41000:A$="Time remaining = "+TR$+" min.":GOSUB 1400 1240 IF XPR THEN 1250 ELSE GOSUB 50100 1250 GOSUB 1400:A$="Function <B,C,E,F,G,H,K,L,M,N,O,P,PL,PW,Q,R,S,T,U,W,X,#,?,!>" 1260 GOSUB 1500:IF Q=0 THEN 1250 1270 FOR J=1 TO Q 1275 Z$=B$(J):GOSUB 5000:IF Z$="10" AND SYSOP THEN GOSUB 12000 1280 Z$=B$(J):GOSUB 5000:IF Z$="PW" THEN 5100 ELSE IF Z$="PL" THEN 5200 1290 FF=INSTR("?BCEFGHKLMNOPQRSTWX#U!123456789",Z$) 1300 IF FF=0 THEN 1350 ELSE IF FF>22 AND NOT SYSOP THEN 1350 1310 ' ? B C E F G H K L M N O P 1320 ON FF GOSUB 1700,1720,1800,2000,20000,10560,1740,3900,4100,10960,5500,4700,4200,4320,4330,4340,9100,1760,4240,4900,10090,900,10070,10090,10110,10270,10390,10490,10530,11000,9500 1330 ' Q R S T W X # U ! 1 2 3 4 5 6 7 8 9 1340 NEXT J:GOTO 1200 1350 IF XPR THEN 1240 ELSE GOSUB 1400 1360 A$=FIRST$+", I don't understand "+B$(J)+".":GOSUB 1400:GOTO 1200 1400 RET=0' Print string -------------------------- 1405 IF NOT STI OR CHAT THEN 1435 1410 Y$=INKEY$:IF LOCAL THEN 1430 1415 IF EOF(3) THEN GOSUB 42000:GOTO 1430 1416 ON ERROR GOTO 13000 1420 Y$=INPUT$(1,#3) 1425 IF Y$=CHR$(19) THEN WHILE EOF(3):GOSUB 42000:WEND:GOTO 1420 1427 ' 1430 IF Y$=ABT$ AND STI THEN 1475 1435 IF PRT THEN LOCATE ,,1:PRINT A$; 1437 IF LOCAL THEN 1450 1440 IF UC THEN SWAP A$,Z$:GOSUB 5000:SWAP A$,Z$ 1445 PRINT #3,A$; 1450 IF CR=1 THEN 1470 1455 PRINT:IF LOCAL THEN 1465 1460 PRINT #3,"":IF LF THEN PRINT #3,LF$; 1465 IF CR=2 THEN CR=0:GOTO 1455 1470 Y$="":A$="":CR=0:RETURN 1475 CLOSE 2:CR=2:A$="":RET=STI:STI=0:GOSUB 1410:STI=RET:RET=-1:GOTO 1470 1500 'Input string -------------------------------- 1502 GOSUB 42000:A=FRE(""):TOUT!=TIMER 1505 A=0:B=0:C=0:Q=1:EOL=0:YES=0:B$="":NO=0 1510 A$=A$+"? ":CR=1:GOSUB 1400 1515 ' 1520 IF LOCAL THEN LINE INPUT"",B$:GOTO 1575:ELSE IF BELL THEN PRINT#3,CHR$(7); 1525 WHILE EOF(3) 1526 GOSUB 42000 1527 MMM!=TIMER-TOUT! 1528 IF MMM!>TIME.OUT! THEN RUN 1530 Y$=INKEY$:IF Y$<>"" THEN 1545 1535 WEND:IF INP(&H3FE)<128 THEN 13900 1540 Y$=INPUT$(1,3) 1544 IF Y$=CHR$(127) THEN 1635 1545 IF Y$=CHR$(8) THEN 1635 1550 IF Y$<" " AND Y$<>CR$ THEN 1525 1555 IF PRT THEN PRINT Y$; 1557 IF NOT SECURE THEN PRINT #3,Y$; ELSE PRINT #3,"."; 1560 IF Y$=CR$ THEN 1570 1563 IF LEN(B$)=>254 THEN A$="Input string too long. Try again.":GOSUB 1400:GOTO 1500 1565 B$=B$+Y$:GOTO 1525 1570 IF LF THEN PRINT #3,LF$; 1575 A=INSTR(B$,";"):IF A=0 THEN 1620 1580 B$(1)=LEFT$(B$,A-1):A=A+1 1585 B=INSTR(A,B$,";") 1590 C=B-A:IF C<1 THEN EOL=-1:C=128 1595 BB$=MID$(B$,A,C) 1600 IF BB$<>"" THEN Q=Q+1:B$(Q)=BB$ 1605 IF NOT EOL AND Q<10 THEN A=B+1:GOTO 1585 1610 IF LEN(B$)>19 THEN A$="Try again, "+FIRST$+".":GOSUB 1400:GOTO 1500 1615 RETURN 1620 B$(1)=B$:IF B$="" THEN Q=0 1625 IF LEFT$(B$,1)="Y" OR LEFT$(B$,1)="y" THEN YES=-1 1627 IF LEFT$(B$,1)="N" OR LEFT$(B$,1)="n" THEN NO=-1 1630 RETURN 1635 IF LEN(B$)=0 THEN 1525 1640 B$=LEFT$(B$,LEN(B$)-1) 1645 IF PRT THEN PRINT BK1$; 1650 PRINT #3,BK$;:GOTO 1525 1700 '? Type Functions Supported ------------------ 1710 FILE$=HELP02$:GOSUB 6000:RETURN 1720 ' 1730 FILE$=BULLETIN$:GOSUB 6000:GOSUB 9700:RETURN 1740 'Type Help File ------------------------------ 1750 FILE$=HELP01$:GOSUB 6000:RETURN 1760 'Type Welcome -------------------------------- 1770 FILE$=WELCOME$:GOSUB 6000:RETURN 1800 'Comments ------------------------------------ 1810 GOSUB 1400:A$="Comments are readable by Sysop only.":GOSUB 1400:MARGIN=72 1820 A$="Do you wish to leave a comment":GOSUB 1500 1830 IF NOT YES THEN A$="No comment.":GOSUB 1400:RETURN 1840 T$="SYSOP":SUB$="COMMENTS":SC=-1:LI=0:ERASE A$:DIM A$(30) 1850 GOSUB 1400:A$="Enter up to 20 lines (lone C/R to end).":GOSUB 1400 1860 GOSUB 1400:GOSUB 3200 1870 LI=LI+1:A$=RIGHT$(STR$(LI),2)+": "+A$(LI) 1880 CR=1:GOSUB 1400:GOSUB 3700 1890 IF A$(LI)="" THEN LI=LI-1:IF LI<1 THEN RETURN ELSE 2300 1900 IF LI=18 THEN A$="Two lines left...":GOSUB 1400 1910 IF LI=19 THEN A$="Last line.":GOSUB 1400 1920 IF LI=20 AND NOT SYSOP THEN A$="Comment full.":GOSUB 1400:GOTO 2300 1930 GOTO 1870 1940 CLOSE 2:OPEN "A",#2,COMMENTS$ 1950 GOSUB 1400:A$="Many thanks for the comments, "+FIRST$+" !":GOSUB 1400 1960 GOSUB 482:PRINT #2,NAM$,D$,TIM$ 1970 FOR X=1 TO LI:PRINT #2,A$(X):NEXT 1980 FOR X=1 TO 2:PRINT #2,CHR$(13):NEXT:CLOSE 2:RETURN 2000 'Enter A Message ----------------------------- 2005 GOSUB 1400:IF LASTR=MESSAGE.MAX THEN A$="Too many active messages -- try again another day.":GOSUB 1400:RETURN 1200 2010 T$="":PAS$="":LI=0:L=0:X=0:SC=0:ERASE A$:DIM A$(30) 2015 A$="Message will be # "+STR$(LASTM+1):GOSUB 1400 2020 A$="To (C/R For All)":GOSUB 1500 2025 IF LEN(B$(1))>30 THEN A$="30 Chars max.":GOSUB 1400:GOTO 2020 2030 IF Q=0 THEN T$="ALL" ELSE Z$=B$(1):GOSUB 5000:T$=Z$ 2035 A$="Subject":GOSUB 1500 2040 IF LEN(B$(1))>25 THEN A$="25 Chars max.":GOSUB 1400:GOTO 2035 2045 IF Q=0 THEN RETURN 1200 ELSE Z$=B$(1):GOSUB 5000:SUB$=Z$ 2050 A$="Protect <K,R,N,H,?>":IF XPR THEN 2060 2055 A$="Protect < K)ill, R)ead, N)one, H)elp >" 2060 GOSUB 1500:IF Q=0 THEN 2035 ELSE Z$=LEFT$(B$(1),1):GOSUB 5000:X=INSTR("KRNH?",Z$) 2065 ON X GOTO 2085,2075,2100,2070,2055:GOTO 2050 2070 FILE$=HELP03$:GOSUB 6000:GOTO 2050 2075 PAS$="^READ^":GOTO 2100 2085 A$="Password":GOSUB 1500 2090 IF LEN(B$(1))>15 THEN A$="15 Chars. max.":GOSUB 1400:GOTO 2085 2095 PAS$=B$(1) 2100 GOSUB 1400:IF XPR THEN 2120 2105 A$="To enter message, type in message text.":GOSUB 1400 2110 A$="Type empty return to end (19 lines max.).":GOSUB 1400 2120 GOSUB 3200 2125 LI=LI+1:A$=RIGHT$(STR$(LI),2)+": "+A$(LI) 2130 CR=1:GOSUB 1400:GOSUB 3700 2135 IF A$(LI)="" THEN LI=LI-1:GOTO 2300 2140 IF LI=17 THEN A$="Two lines left...":GOSUB 1400 2145 IF LI=18 THEN A$="Last line.":GOSUB 1400 2150 IF LI=19 AND NOT SYSOP THEN A$="Message full.":GOSUB 1400:GOTO 2300 2155 GOTO 2125 2300 'Editing dispatcher -------------------------- 2305 GOSUB 1400 2310 IF XPR THEN 2315 ELSE GOSUB 50400 2315 GOSUB 1400:A$="Subfunction <A,C,D,E,I,L,M,S,?>" 2320 GOSUB 1500:IF Q=0 THEN 2315 ELSE Z$=B$(1):GOSUB 5000 2325 IF Q>1 AND Z$<>"M" THEN L=VAL(B$(Q)):GOSUB 3320 2330 FF=INSTR("ACDEILMS?",Z$):IF FF<1 OR FF>9 THEN 2310 2335 ON FF GOTO 2400,2340,2500,2600,2800,3000,3100,3400,2345 2340 GOSUB 3200:GOTO 2140 2345 FILE$=HELP04$:GOSUB 6000:GOTO 2315 2400 'Abort --------------------------------------- 2410 GOSUB 1400:A$="Abort this message":GOSUB 1500 2420 IF NOT YES THEN 2300 2430 GOSUB 1400:A$="Aborted":GOSUB 1400:RETURN 1200 2500 'Delete A Line ------------------------------- 2510 GOSUB 1400:IF Q=1 THEN A$="Delete ":CR=1:GOSUB 1400:GOSUB 3300 2520 A$="Line #"+STR$(L):GOSUB 1400:A$=A$(L):CR=2:GOSUB 1400 2530 A$="Delete this line":GOSUB 1500 2540 IF NOT YES THEN A$="Line #"+STR$(L)+" NOT Deleted.":GOSUB 1400:GOTO 2300 2550 LI=LI-1:FOR X=L TO LI:A$(X)=A$(X+1):NEXT:A$(LI+1)="" 2560 A$="Line #"+STR$(L)+" Deleted.":GOSUB 1400:GOTO 2300 2600 'Edit A Line --------------------------------- 2610 GOSUB 1400:IF Q=1 THEN GOSUB 3300 2620 A$="Line #"+STR$(L)+" is:":GOSUB 1400:A$=A$(L):CR=2:GOSUB 1400 2630 A$="Enter <Oldstring;Newstring> or C/R for no change.":GOSUB 1400 2640 GOSUB 1400:GOSUB 1500 2650 IF Q=0 THEN 2300 2660 X=INSTR(1,A$(L),B$(1)):IF X=0 THEN 2710 2670 LB1=LEN(B$(1)):LB2=LEN(B$(2)):IF LB1<>LB2 THEN 2690 2680 MID$(A$(L),X)=B$(2):GOTO 2620 2690 C$=MID$(A$(L),X+LB1):CC$=LEFT$(A$(L),X-1) 2700 A$(L)=CC$+B$(2)+C$:GOTO 2620 2710 A$="String <"+B$(1)+"> not found in line"+STR$(L)+".":GOSUB 1400:GOTO 2300 2800 'Insert A Line ------------------------------- 2810 IF LI=20 AND NOT SYSOP THEN 2300 ELSE ERASE C$:DIM C$(30) 2820 GOSUB 1400:IF Q=1 THEN A$="Before ":CR=1:GOSUB 1400:GOSUB 3300 2830 W=LI:K=LI-L:FOR X=L TO LI:C$(X+1-L)=A$(X):A$(X)="":NEXT:LI=L 2840 A$=RIGHT$(STR$(LI),2)+": " 2850 CR=1:GOSUB 1400:GOSUB 3700 2860 IF A$(LI)="" THEN 2920 2870 LI=LI+1 2880 IF LI+K=18 THEN A$="Two lines left...":GOSUB 1400 2890 IF LI+K=19 THEN A$="Last line.":GOSUB 1400 2900 IF LI+K=20 AND NOT SYSOP THEN A$="Message full.":GOSUB 1400:GOTO 2920 2910 GOTO 2840 2920 FOR X=1 TO K+1:A$(LI+X-1)=C$(X):NEXT:LI=W+LI-L 2930 GOTO 2300 3000 STI=-1'List Lines ---------------------------- 3010 GOSUB 1400:IF Q=1 THEN L=1:A$="To: "+T$+" Re: "+SUB$:GOSUB 1400:GOSUB 3200 3020 FOR X=L TO LI:IF RET THEN 2300 ELSE A$=RIGHT$(STR$(X),2)+": "+A$(X) 3030 GOSUB 1400:NEXT:GOTO 2300 3100 'Set Right Margin ---------------------------- 3110 GOSUB 1400:IF Q<>1 THEN B$(1)=B$(Q):GOTO 3130 3115 A$="Right-Margin is set at"+STR$(MARGIN):GOSUB 1400 3120 A$="Set Right-Margin to (8,16,24,32,40,48,56,64,72)":GOSUB 1500 3130 X=VAL(B$(1)):IF X>0 AND X<81 AND X MOD 8=0 THEN 3150 3140 A$="Invalid - Margin remains at"+STR$(MARGIN)+".":GOSUB 1400:IF MAINMARG THEN RETURN ELSE GOTO 2300 3150 MARGIN=VAL(B$(1)):A$="Margin now set to"+STR$(MARGIN)+".":GOSUB 1400:IF MAINMARG THEN RETURN ELSE GOTO 2300 3200 'Print Tab Settings -------------------------- 3210 GOSUB 1400:A$=" ["+STRING$(MARGIN-2,45)+"]":GOSUB 1400:RETURN 3300 'Test Line Number ---------------------------- 3310 A$="Line #":GOSUB 1500:L=VAL(B$(1)) 3320 IF L=>1 AND L=<LI THEN RETURN 3330 IF Q=0 THEN RETURN 2300 3340 A$="No such line, "+FIRST$+".":GOSUB 1400:RETURN 2300 3400 'Save Message -------------------------------- 3405 IF SC THEN 1940 3410 GOSUB 1400:A$="Updating Message file.":CR=1:GOSUB 1400 3440 X#=0:REC=0:N$="":LASTM=LASTM+1:LASTR=LASTR+1 3450 MNUM$=STR$(LASTM)+SPACE$(5-LEN(STR$(LASTM))) 3455 IF PAS$="^READ^" THEN MID$(MNUM$,1,1)="*" 3460 FROM$=NAM$+SPACE$(31-LEN(NAM$)) 3470 T$=T$+SPACE$(31-LEN(T$)):MID$(T$,23,8)=TIME$ 3480 SUB$=SUB$+SPACE$(25-LEN(SUB$)) 3490 PAS$=PAS$+SPACE$(15-LEN(PAS$)) 3500 FOR J=1 TO LI:A$(J)=A$(J)+CHR$(227):REC=REC+LEN(A$(J)):NEXT 3510 IF REC MOD 128=0 THEN N$=STR$(REC\128+1) ELSE N$=STR$(REC\128+2) 3520 CLOSE 1:OPEN "R",1,MESSAGES$,128:FIELD 1,128 AS R$:X#=LOF(1)/128:GET 1:A$=SPACE$(8):LSET A$=STR$(LASTM):LSET R$=A$+MID$(R$,9,12)+NAM$:PUT 1,1 3530 GET 1,X#:M(LASTR,1)=X#+1:M(LASTR,2)=LASTM 3540 ' 3550 LSET R$=MNUM$+FROM$+T$+D$+SUB$+PAS$+CHR$(225)+N$:PUT 1,M(LASTR,1) 3600 'Pack Disk Record ---------------------------- 3610 N$="":FOR J=1 TO LI:A$=".":CR=1:GOSUB 1400 3620 N$=N$+A$(J):IF LEN(N$)>127 THEN LSET R$=N$:PUT 1:N$=MID$(N$,129) 3630 NEXT J 3640 LSET R$=N$:PUT 1:GOSUB 1400:RETURN 1200 3650 ' 3700 'Word Processor ------------------------------ 3710 RS$=A$(LI):COL=LEN(RS$):STI=0 3720 COL=COL+1 3730 IF LOCAL THEN X$=INPUT$(1):GOTO 3740 3732 TOUT!=TIMER:WHILE EOF(3):MMM!=TIMER-TOUT!:IF MMM!>TIME.OUT! THEN RUN 3733 GOSUB 42000:X$=INKEY$:IF LEN(X$)=1 THEN 3740 3734 WEND:X$=INPUT$(1,3) 3736 IF X$=CHR$(10) THEN 3730 3738 IF X$=CHR$(127) THEN 3870 3740 IF X$=CHR$(8) THEN 3870 3750 A$=X$:CR=1:GOSUB 1400 3760 IF X$=CHR$(13) THEN 3850 3770 IF COL>MARGIN-3 AND X$=" " THEN GOSUB 1400:GOTO 3850 3780 RS$=RS$+X$ 3790 IF COL<MARGIN+1 THEN 3720 3800 Z=LEN(RS$) 3810 WHILE MID$(RS$,Z,1)<>" ":Z=Z-1:IF Z>0 THEN WEND ELSE Z=LEN(RS$)-1 3820 COL=MARGIN+1-Z:IF PRT THEN PRINT STRING$(COL,29);STRING$(COL,0); 3830 IF NOT LOCAL THEN PRINT #3,STRING$(COL,8);STRING$(COL,32); 3840 A$(LI)=LEFT$(RS$,Z):A$(LI+1)=RIGHT$(RS$,COL):GOSUB 1400:RETURN 3850 IF NOT LOCAL AND LF THEN PRINT #3,LF$; 3860 A$(LI)=RS$:RETURN 3870 IF COL=1 THEN 3730 ELSE COL=COL-2:RS$=LEFT$(RS$,LEN(RS$)-1) 3880 IF PRT THEN PRINT BK1$; 3885 IF NOT LOCAL THEN PRINT #3,BK$; 3890 GOTO 3720 3900 'Kill A Message ------------------------------ 3910 GOSUB 1400 3920 IF Q<>1 THEN MM=VAL(B$(Q)):GOTO 3950 3930 A$="Msg # to Kill":GOSUB 1500:MM=VAL(B$(Q)):GOSUB 1400 3940 IF MM=0 THEN RETURN 3950 FOR Q=1 TO LASTR:IF M(Q,2)=MM THEN 3970 ELSE NEXT 3960 A$="There is no message # "+STR$(MM)+".":GOSUB 1400:RETURN 1200 3970 GET 1,M(Q,1):R=VAL(MID$(R$,118)):IF SYSOP THEN 4030 3980 Z=15:Z$=MID$(R$,101,15):GOSUB 8100:IF LEN(Z$)=0 THEN 4030 3990 IF Z$="^READ^" THEN IF INSTR(R$,NAM$) THEN 4030 ELSE 4020 4000 A$="Password (dots will echo)":SECURE=-1:GOSUB 1500:SECURE=0:GOSUB 1400 4010 IF B$(1)=Z$ THEN 4030 4020 A$="Sorry, wrong password. Message is protected.":GOSUB 1400:GOSUB 40000:RETURN 1200 4030 LSET R$=LEFT$(R$,115)+CHR$(226)+MID$(R$,117):PUT 1,LOC(1) 4040 GOSUB 135 4050 A$="Msg # "+STR$(MM)+" Killed.":GOSUB 1400:RETURN 1200 4100 'Toggle Line Feeds --------------------------- 4110 GOSUB 1400:LF=NOT LF 4120 A$="Line Feeds ":IF LF THEN A$=A$+"On" ELSE A$=A$+"Off" 4130 GOSUB 1400:GOSUB 50500:RETURN 4200 'Toggle Bell --------------------------------- 4210 GOSUB 1400:BELL=NOT BELL 4220 A$="Prompting Bell ":IF BELL THEN A$=A$+"On" ELSE A$=A$+"Off" 4230 GOSUB 1400:GOSUB 50500:RETURN 4240 'Toggle Expert ------------------------------- 4250 GOSUB 1400:XPR=NOT XPR 4260 IF XPR THEN A$="Expert Mode" ELSE A$="Novice Mode" 4300 GOSUB 1400:GOSUB 50500:RETURN 4310 'Quick Scan & Summary & Retrieval ------------ 4320 QU=-1:RT=0:SU=0:GOTO 4350 4330 QU=0:RT=-1:SU=0:GOTO 4350 4340 QU=0:RT=0:SU=-1 4350 IF Q>2 AND VAL(B$(Q))=0 THEN Z$=B$(Q):Q=Q-1 ELSE Z$="" 4360 GOSUB 5000:SC$=Z$:L=1:LI=Q 4370 L=L+1:IF L<=LI THEN MM=VAL(B$(L)):GOTO 4415 4380 A$="Msg # ("+STR$(FIRSTM)+" to"+STR$(M(LASTR,2))+", *, <H>elp)":IF XPR THEN 4400 4390 IF RT THEN A$=A$+" to Retrieve (C/R to end)" ELSE A$="Starting at "+A$ 4400 GOSUB 1500:IF LEFT$(B$(1),1)="H" OR LEFT$(B$(1),1)="h" THEN FILE$=HELP07$:GOSUB 6000:RETURN 1200 ELSE IF Q=0 THEN RETURN 1200 ELSE L=0:LI=Q:GOTO 4370 4410 ' 4415 FOW=0:REV=0 4420 IF B$(L)="*" THEN MM=LMSG+1:FOW=-1 ELSE IF MM=0 THEN RETURN 1200 ELSE GOSUB 1400 4430 IF RIGHT$(B$(L),1)="+" THEN FOW=-1 4440 IF RIGHT$(B$(L),1)="-" THEN REV=-1:GOTO 4490 4450 FOR R=1 TO LASTR 4460 IF RT AND M(R,2)=MM THEN 4520 4470 IF ((RT AND FOW) OR QU OR SU) AND M(R,2)=>MM THEN 4520 4480 NEXT:GOTO 4515 4490 FOR R=LASTR TO 1 STEP -1 4500 IF M(R,2)<=MM THEN 4540 4510 NEXT 4515 A$="Sorry, "+FIRST$+", there is no message #"+STR$(MM)+".":GOSUB 1400:GOTO 4370 4520 QQQ=R:IF RT AND NOT FOW THEN 4560 4530 QQ=R:QQQ=LASTR:QQQQ=1:GOTO 4550 4540 QQ=R:QQQ=1:QQQQ=-1 4550 FOR R=QQ TO QQQ STEP QQQQ 4555 ' 4560 GET 1,M(R,1) 4565 PROTEC=0 4570 IF NOT SYSOP THEN IF INSTR(R$,"^READ^")>0 AND INSTR(R$,NAM$)=0 THEN PROTEC=-1 4580 IF INSTR(R$,SC$)=0 THEN 4635 4585 IF PROTEC THEN SUBJ$="<PROTECTED>" ELSE SUBJ$=MID$(R$,76,25) 4590 IF QU THEN Z$=LEFT$(R$,5)+" "+SUBJ$:Z=31:GOSUB 8100:A$=Z$:GOSUB 1400:GOTO 4630 4600 GOSUB 8000:IF SU OR RET THEN 4630 ELSE IF M(R,2)>LMSG THEN LMSG=M(R,2) 4610 IF PROTEC THEN GOSUB 4670 ELSE GOSUB 9000 4615 GOSUB 1400 4620 IF (R<>QQQ OR L<>LI) AND Q AND PL<>0 THEN A$="End of item. More":GOSUB 1500:IF NO THEN 4650 4625 IF NOT FOW AND NOT REV THEN 4370 4630 IF RET THEN RETURN 1200 4635 NEXT R 4640 ' 4645 IF RT THEN 4370 4650 GOSUB 1400:A$="End of Msgs.":GOSUB 1400:RETURN 1200 4660 ' 4670 GOSUB 1400:A$="Sorry, "+FIRST$+", msg # "+LEFT$(R$,5)+" is read protected." 4680 GOSUB 1400:RETURN 4700 'O Chat -------------------------------------- 4702 IF NOT AVAILABLE GOTO 4750 4705 GOSUB 1400:A$="Chat... Remote Conversation Utility.":CR=2:GOSUB 1400 4706 ' 4707 TRY.BELL=VAL(MID$(TIME$,1,2))*100+VAL(MID$(TIME$,4,2)):IF (TRY.BELL>ANNOY.ON AND TRY.BELL<ANNOY.OFF) AND ANNOY THEN 4710 4708 A$="Operator doesn't want to be bugged... try again another time "+FIRST$+".":GOSUB 1400:GOTO 4755 4710 A$="Program returns to command level within":GOSUB 1400 4715 A$="30 seconds if operator is unavailable.":CR=2:GOSUB 1400 4720 K=0:A$="Alerting operator now...":CR=1:GOSUB 1400 4725 FOR I=1 TO 26:FOR J=1 TO 500:NEXT J 4730 ' 4735 K=K+1:IF INKEY$=CHR$(27) THEN 4765 4740 A$=". ":IF K MOD 2 THEN A$=A$+CHR$(7) 4744 IF LPRT THEN LPRINT CHR$(7); 4745 CR=1:GOSUB 1400:NEXT:GOSUB 1400 4750 A$="Sorry "+FIRST$+", no operator available.":GOSUB 1400 4755 A$="Please leave a message on the board or in the comments." 4760 GOSUB 1400:RETURN 4765 GOSUB 1400:A$="Operator is available. Go ahead...":CR=2:GOSUB 1400 4770 'Forced chat enters here 4772 CHAT=TRUE 4775 WHILE EOF(3):A$=INKEY$ 4780 IF A$=CHR$(8) THEN 4805 ELSE IF A$=CHR$(27) THEN CHAT=FALSE:CLS:KEY (10) ON:RETURN 1200 4785 IF A$=CR$ AND LF THEN PRINT #3,LF$; 4790 IF A$<>"" THEN CR=1:GOSUB 1400:GOTO 4775 4795 WEND:A$=INPUT$(1,#3):IF A$=CHR$(8) THEN 4805 ELSE IF A$=CR$ AND LF THEN PRINT #3,LF$; 4800 CR=1:GOSUB 1400:GOTO 4775 4805 IF POS(0)>1 THEN PRINT BK1$;:PRINT #3,BK$; 4810 GOTO 4775 4900 '# Counters ---------------------------------- 4910 GOSUB 1400 4920 A$="You are caller # ->"+STR$(CALLN):GOSUB 1400 4930 A$="# of Active msgs ->"+STR$(LASTR):GOSUB 1400 4940 IF LMSG>0 THEN A$="Last msg you read ->"+STR$(LMSG):GOSUB 1400 4950 A$="Next msg # will be->"+STR$(LASTM+1):GOSUB 1400:RETURN 5000 'Convert Lower Case to Upper Case ------------ 5010 FOR Z=1 TO LEN(Z$) 5020 MID$(Z$,Z,1)=CHR$(ASC(MID$(Z$,Z,1))+32*(ASC(MID$(Z$,Z,1))>96)) 5030 NEXT Z:RETURN 5100 'Change Password Function ------------------------ 5110 A$="What would you like for a new password":SECURE=-1:GOSUB 1500:SECURE=0:GOSUB 1400:IF Q=0 THEN 1200 ELSE IF LEN(B$(1))>15 THEN 5110 ELSE Z$=B$(1):GOSUB 5000 5120 A$="Type new password again ":SECURE=-1:GOSUB 1500:SECURE=0:GOSUB 1400:IF Q=0 THEN 1200 ELSE SWAP Z$,B$(1):GOSUB 5000:IF Z$<>B$(1) THEN A$="Passwords don't match.":GOSUB 1400:GOTO 1200 5130 GOSUB 9400:GET 2,UIX#:LSET PW$=Z$:PUT 2,UIX#:CLOSE 2:GOSUB 1400:A$="Password change complete. ":GOSUB 1400:GOTO 1200 5200 'Change Page Length Function -------------------------------- 5210 IF Q>1 THEN 5230 5220 A$="Page length is"+STR$(PL)+". Enter new page length or zero for continuous":GOSUB 1500:IF Q=0 THEN 1200 5230 A=VAL(B$(Q)):IF A<0 OR A>255 THEN 5220 ELSE PL=A:GOTO 1200 5500 'Swap baud rate 300 <=> 450 ------------------ 5505 IF BPS=-1 THEN A$="Sorry, 1200 baud connect cannot change speed.":GOSUB 1400:RETURN 5507 A$="Do you wish to change to 450 baud":GOSUB 1500:IF NOT YES THEN RETURN 5510 A$="Change baud rate to 450, then enter <c/r> until I respond...":GOSUB 1400:FOR X=1 TO 10000:NEXT:C=0 5520 SWAP BPS,NBPS:CALL BAUDS(BPS) 5530 C=C+1:GOSUB 42000:IF C=20 THEN RUN ELSE IF C=10 THEN 5520 ELSE X=ASC(INPUT$(1,3)):IF X=13 THEN 5540 ELSE 5530 5540 CLOSE 2:OPEN "A",2,CALLERS$ 5550 Z$=" == Swiched to 450 baud ==":PRINT #2,Z$:CLOSE 2:IF LPRT THEN LPRINT Z$ 5560 RETURN 6000 'Common Routine to Print A File --------------------------- 6010 GOSUB 1400:A$="* Use <^K> to abort, <^S> to suspend *":CR=2:GOSUB 1400 6020 OPEN "I",#2,FILE$:Q=0:GOTO 6040 6030 Q=-1 6040 IF EOF(2) THEN 6060 6045 IF PL AND Q>=0 THEN Q=Q+1:IF Q>=PL THEN A$="More":GOSUB 1500:IF NO THEN 6060 ELSE Q=0 6050 LINE INPUT #2,A$:GOSUB 1400:IF NOT RET THEN 6040 6060 Q=0:CLOSE 2:RETURN 6070 ' 6080 A$="Please let the SYSOP know that file <"+FILE$+"> is missing!":GOSUB 1400:RETURN 7000 'Common Routine To Test Fields ---------------------------- 7010 GET 1,R:RR=VAL(MID$(R$,118)) 7020 IF RR<1 THEN DONE=-1:RETURN 7030 R=R+RR 7040 IF INSTR(MID$(R$,X,Y),F$) THEN RETURN 7050 GOTO 7010 8000 'Process Message Header ---------------------- 8010 GOSUB 1400:IF RET THEN RETURN 8020 IF MID$(R$,37,3)="ALL" THEN T$="ALL":GOTO 8040 8030 Z=22:Z$=MID$(R$,37,Z):GOSUB 8100:T$=Z$ 8040 Z=25:Z$=MID$(R$,76,Z):GOSUB 8100:SUB$=Z$:IF PROTEC THEN SUB$=SUBJ$ 8050 Z=31:Z$=MID$(R$, 6,Z):GOSUB 8100:FROM$=Z$ 8060 A$="Msg # "+LEFT$(R$,5)+" Dated "+MID$(R$,68,8)+" "+MID$(R$,59,8) 8065 GOSUB 1400:IF NOT RET THEN A$="From: "+FROM$ 8070 GOSUB 1400:IF NOT RET THEN A$=" To: "+T$:GOSUB 1400:IF NOT RET THEN A$=" Re: "+SUB$:GOSUB 1400 8080 RETURN 8090 'Remove Spaces That Pad Msg Header ----------------------- 8100 WHILE MID$(Z$,Z,1)=" ":Z=Z-1:IF Z>0 THEN WEND 8110 Z$=MID$(Z$,1,Z):RETURN 9000 'Unpack Disk Record -------------------------- 9010 GOSUB 1400:Q=4 9020 FOR X=2 TO VAL(MID$(R$,118)) 9030 CR=1:GOSUB 1400:EOL=0:J=1:GET 1 9040 ' 9050 B=INSTR(J,R$,CHR$(227)):IF RET THEN RETURN 9060 C=B-J:IF C<1 THEN C=128:EOL=-1 9070 A$=MID$(R$,J,C):IF EOL THEN 9090 9075 GOSUB 1400:J=B+1 9080 IF PL THEN Q=Q+1:IF Q>=PL THEN A$="More":GOSUB 1500:Q=0:IF NO THEN RETURN 9085 GOTO 9050 9090 NEXT:A$="":RETURN 9100 'Time On System ------------------------------ 9110 GOSUB 1400 9120 H=VAL(LEFT$(TI$,2)):M=VAL(MID$(TI$,4,2)):S=VAL(MID$(TI$,7,2)) 9130 HH=VAL(LEFT$(TIME$,2)):MM=VAL(MID$(TIME$,4,2)):SS=VAL(MID$(TIME$,7,2)) 9140 IF S=<SS THEN SSS=SS-S ELSE SSS=60-(S-SS):M=M+1 9150 IF M=<MM THEN MMM=MM-M ELSE MMM=60-(M-MM):H=H+1 9160 IF H=<HH THEN HHH=HH-H ELSE HHH=24-(H-HH) 9170 GOSUB 482:A$="It is now "+TIM$+".":GOSUB 1400 9180 A$="You have been on for":CR=1:GOSUB 1400 9190 IF HHH>0 THEN A$=STR$(HHH)+" Hours":CR=1:GOSUB 1400 9200 A$=STR$(MMM)+" Minutes and"+STR$(SSS)+" Seconds.":GOSUB 1400:RETURN 9400 'Routine to open users file ---------------------------- 9410 CLOSE 2:OPEN "R",2,USERS$,128:FIELD 2,31 AS N$,15 AS PW$,1 AS ST$,15 AS OP$,24 AS CS$,20 AS MA$,14 AS TD$:RETURN 9500 'SYSOP AVAILABILITY------------------------- 9510 GOSUB 1400:AVAILABLE=NOT AVAILABLE 9520 A$="SYSOP is ":IF AVAILABLE THEN A$=A$+"available..." ELSE A$=A$+"not available...." 9530 GOSUB 1400:GET 1,1:MID$(R$,9,2)=STR$(AVAILABLE):PUT 1,1:RETURN 9700 ' BULLETIN SUBSYSTEM ------------------------------ 9710 GOSUB 1400:A$="Bulletin # <1,2,3,4,5,6, L)ist or C/R to end>" 9720 GOSUB 1500:IF Q=0 THEN RETURN ELSE Z$=B$(1):GOSUB 5000 9730 FF=INSTR("123456L",Z$) 9740 IF FF<1 OR FF>7 THEN 9710 9750 ON FF GOSUB 9760,9770,9780,9790,9800,9810,9820 9755 RETURN 9760 FILE$=BULLET1$:GOSUB 6000:GOTO 9700 9770 FILE$=BULLET2$:GOSUB 6000:GOTO 9700 9780 FILE$=BULLET3$:GOSUB 6000:GOTO 9700 9790 FILE$=BULLET4$:GOSUB 6000:GOTO 9700 9800 FILE$=BULLET5$:GOSUB 6000:GOTO 9700 9810 FILE$=BULLET6$:GOSUB 6000:GOTO 9700 9820 FILE$=BULLETIN$:GOSUB 6000:GOTO 9700 10000 'Sysop's Utilities --------------------------- 10010 ' 10020 A$="Sysop's Utilities:":GOSUB 1400 10030 A$=" 1 List comments | 2 List callers log":GOSUB 1400 10040 A$=" 3 Pack msg file | 4 Renumber msg file":GOSUB 1400 10050 A$=" 5 Recover a Msg | 6 List message headers":GOSUB 1400 10060 A$=" 7 Erase comments | 8 Users file maintenance":GOSUB 1400 10065 A$=" 9 Toggle page bell | 10 Pack users file":CR=2:GOSUB 1400:RETURN 10070 '1 ------------------------------------------- 10080 FILE$=COMMENTS$:GOSUB 6000:RETURN 10090 '2 ------------------------------------------- 10100 FILE$=CALLERS$:GOSUB 6000:RETURN 10110 '3 ------------------------------------------- 10111 A$="Do you want to pack MESSAGES file":GOSUB 1500:IF NO THEN RETURN 1200 10112 OK=0:NAME MESSAGES.BAK$ AS MESSAGES.BAK$ 10113 IF NOT OK THEN 10120 10115 KILL MESSAGES.BAK$ 10120 CLOSE #1,2:NAME MESSAGES$ AS MESSAGES.BAK$:Q=0 10130 OPEN "R",#1,MESSAGES.BAK$:FIELD #1,128 AS R$ 10140 OPEN "R",#2,MESSAGES$:FIELD #2,128 AS RR$:GET 1:GOTO 10240 10150 GET 1 10160 IF INSTR(R$,CHR$(225))>0 THEN 10220 10170 IF INSTR(R$,CHR$(227))>0 THEN 10240 10180 IF INSTR(R$,CHR$(226))>0 THEN 10250 10190 GOSUB 1400:A$="# of Msgs Purged :"+STR$(Q):GOSUB 1400 10200 A$="# of Bytes Purged:"+STR$((LOC(1)*128)-(LOC(2)*128)):GOSUB 1400 10210 A$="Re-Loading Msg File...":GOSUB 1400:GOSUB 135:RETURN 1200 10220 A$="Msg #"+LEFT$(R$,5)+" copied...":GOSUB 1400 10240 LSET RR$=R$:PUT 2:GOTO 10150 10250 Q=Q+1:A$="Msg #"+LEFT$(R$,5)+" purged...":GOSUB 1400 10260 GET 1,LOC(1)+VAL(MID$(R$,118)):GOTO 10160 10270 'Renumber ------------------------------------ 10280 A$="Renumber starting with OLD msg #":GOSUB 1500:MM=VAL(B$(1)) 10290 IF Q=0 OR MM<1 THEN RETURN 1200 10300 A$="Start with NEW #":GOSUB 1500:Y=VAL(B$(1)):YY=Y:IF Q=0 THEN 10280 10310 FOR Q=1 TO LASTR 10320 IF M(Q,2)=MM THEN R=M(Q,1):GOTO 10340 10330 NEXT:A$="No Msg #"+STR$(MM):GOSUB 1400:RETURN 1200 10340 GET 1,R 10350 RR=VAL(MID$(R$,118)):IF RR<1 THEN GET 1,1:PUT 1,1:GOTO 10210 10360 LSET R$=STR$(Y)+SPACE$(5-LEN(STR$(Y)))+MID$(R$,6) 10370 PUT 1,LOC(1) 10380 Y=Y+1:R=R+RR:GOTO 10340 10390 'Resurrection -------------------------------- 10400 A$="Msg # to Recover":GOSUB 1500:MM=VAL(B$(1)):IF MM<1 THEN 1450 10410 R=2:GOSUB 1400 10420 GET 1,R:RR=VAL(MID$(R$,118)) 10430 IF RR<1 THEN A$="No Msg #"+STR$(MM):GOSUB 1400:RETURN 10440 IF VAL(MID$(R$,2,4))<>MM THEN R=R+RR:GOTO 10420 10450 IF INSTR(R$,CHR$(226))=0 THEN 10480 10460 LSET R$=LEFT$(R$,115)+CHR$(225)+MID$(R$,117):PUT 1,LOC(1) 10470 A$="Msg #"+STR$(MM)+" is now alive and well.":GOSUB 1400:GOTO 10210 10480 A$="Msg #"+STR$(MM)+" is not Dead.":GOSUB 1400:RETURN 10490 'Print Msg Header ---------------------------- 10500 R=2 10510 GET 1,R:RR=VAL(MID$(R$,118)):IF RR<1 THEN RETURN 10520 A$=R$:GOSUB 1400:R=R+RR:GOTO 10510 10530 'Purge Comments ------------------------------ 10540 A$="Delete all comments":GOSUB 1500:IF YES THEN OPEN "O",#2,COMMENTS$:CLOSE 2 10550 RETURN 1200 10560 'Goodbye ------------------------------------- 10570 GOSUB 9100 10580 IF HHH>0 THEN OPEN "A",2,LONGCALR$:WRITE#2,NAM$,D$,HHH,MMM:CLOSE 2 10590 A$="Thanks for calling, "+FIRST$+ "!":GOSUB 1400:CLOSE:IF SYSOP THEN CLS:RESTORE:RUN 100 10600 GOSUB 9400:GET 2,UIX# 10610 LSET OP$=MKI$(TIMON)+MKI$(LMSG)+MKI$(LF)+MKI$(MARGIN)+MKI$(BELL)+MKI$(XPR)+CHR$(PL)+STRING$(2,0):PUT 2,UIX#:CLOSE 2 10615 IF SYSOPNEXT THEN STOP ELSE RUN 10620 'Log-Off Weasels ----------------------------- 10630 GOSUB 1400:A$="Please sign off. You are denied access.":CR=2:GOSUB 1400 10640 CLOSE 2,3:GOTO 200 10960 'Main menu msg margin ----------- 10970 MAINMARG=-1:GOSUB 3100:MAINMARG=0:RETURN 11000 'USERS file maintenance ------------------- 11004 A$="<L>ist, <P>rint, or <M>odify users":GOSUB 1500:IF Q=0 THEN RETURN 1200 ELSE QQ=0:Z$=LEFT$(B$(1),1):GOSUB 5000:IF Z$="M" THEN STI=0 ELSE IF Z$="P" THEN QQ=-1 11005 GOSUB 9400:Z=1 11010 XY#=LOF(2)/128:FOR J=Z TO XY#:GET 2,J 11015 IF ASC(N$)=0 THEN 11300 ELSE A$=STR$(LOC(2))+":"+N$:IF ST$<>"Y" THEN A$=A$+" <Locked out>":GOTO 11100 11020 A$=A$+"Pw="+PW$+" Times on="+STR$(CVI(MID$(OP$,1,2))):IF QQ THEN LPRINT A$ 11030 GOSUB 1400:A$=" "+TD$+CS$+MA$ 11100 IF QQ THEN LPRINT A$ 11105 GOSUB 1400:IF STI THEN 11300 11110 A$="<D>elete, <N>ew password, <L>ockout, <P>rint, <M>enu, <#>user":GOSUB 1500:IF Q=0 THEN 11310 11115 Z$=LEFT$(B$(1),1):GOSUB 5000:X=INSTR("DNLPSM",Z$) 11120 ON X GOTO 11130,11160,11190,11220,11250,11320 11125 Z=VAL(B$):XY#=LOF(2)/128:IF Z<1 OR Z>XY# THEN 11310 ELSE 11010 11130 LSET N$=STRING$(31,0):GOTO 11290 11160 A$="Enter new password":GOSUB 1500:Z$=B$(1):GOSUB 5000:LSET PW$=Z$:GOTO 11290 11190 IF ST$="Y" THEN LSET ST$="L" ELSE LSET ST$="Y" 11195 GOTO 11290 11220 QQ=NOT QQ:GOTO 11015 11250 GOTO 11300 11290 PUT 2,LOC(2):GOTO 11015 11300 IF RET THEN 11320 11310 NEXT 11320 CLOSE 2:RETURN 1200 12000 'Pack users file by deleted and time lapse--------------------------- 12002 A$="Do you want to pack USERS file":GOSUB 1500:IF NO THEN RETURN 1200 12005 OK=0:USERS.BAK$=USERS$+".BAK":NOW=VAL(LEFT$(DATE$,2)):NAME USERS.BAK$ AS USERS.BAK$ 12010 IF NOT OK THEN 12030 12020 KILL USERS.BAK$ 12030 NAME USERS$ AS USERS.BAK$:Q=0 12040 CLOSE 1:OPEN "R",1,USERS.BAK$,128:FIELD 1,31 AS OLD.N$,15 AS OLD.PW$,1 AS OLD.ST$,15 AS OLD.OP$,24 AS OLD.CS$,20 AS OLD.MA$,14 AS OLD.TD$ 12050 CLOSE 2:OPEN "R",2,USERS$,128:FIELD 2,31 AS N$,15 AS PW$,1 AS ST$,15 AS OP$,24 AS CS$,20 AS MA$,14 AS TD$ 12060 XY!=LOF(1)/128:FOR J=1 TO XY! 12065 GET 1,J 12070 IF ASC(OLD.N$)=0 THEN 12220 12080 ONLAST=VAL(LEFT$(OLD.TD$,2)):LAPSE=NOW-ONLAST:IF LAPSE<0 THEN LAPSE=LAPSE+12 12090 IF LAPSE>LAPSE.MAX THEN 12220 12200 A$=STR$(LOC(1))+": "+OLD.N$+" copied...":GOSUB 1400 12205 LSET N$=OLD.N$:LSET PW$=OLD.PW$:LSET ST$=OLD.ST$:LSET OP$=OLD.OP$:LSET CS$=OLD.CS$:LSET MA$=OLD.MA$:LSET TD$=OLD.TD$ 12210 PUT 2:GOTO 12230 12220 Q=Q+1:A$=STR$(LOC(1))+": "+OLD.N$+" purged...":GOSUB 1400 12230 NEXT 12240 GOSUB 1400:A$="# users purged:"+STR$(Q):GOSUB 1400 12250 A$="Reloading files...":GOSUB 1400:CLOSE 1,#2:GOSUB 135:GOSUB 9400:RETURN 1200 13000 'Error Trapping ------------------------------ 13001 IF ERR=64 AND ERL=20220 THEN 13080 13002 IF (ERR=7 OR ERR=69) THEN CLEAR:RUN 13003 IF ERR=27 THEN LPRT=FALSE:RESUME 13004 IF ERR=55 THEN CLOSE 2:RESUME 13005 IF ERR=58 THEN 13012 13006 IF ERR=ERR.LAST THEN ERR.COUNT=ERR.COUNT+1:IF ((ERR.COUNT>ERR.MAX) AND (TIMER-TIMERR!<5)) THEN 50000 13007 IF (ERR<>58 AND ERR<>57 AND ERR<>53 AND LPRT) THEN LPRINT "+++ Error";ERR;" in line ";ERL " occurred at " TIME$ " on " DATE$ 13008 ERR.LAST=ERR:TIMERR!=TIMER 13009 IF ERR=57 AND ERL=1420 THEN GOSUB 50000 13010 IF 65535!=ERL THEN 50000 13011 IF ERR=63 AND ERL=10600 THEN RUN 13012 IF ERL=13900 THEN RESUME 13900 13013 IF ERR=52 AND ERL=6050 THEN RESUME 6060 13015 IF ERL=10115 OR ERL=12020 THEN RESUME NEXT 13017 IF ERR=57 THEN IF ERL=5530 THEN RESUME 20015 13020 IF ERR=61 AND ERL=12210 THEN A$="Disk full -- restoring USERS file.":GOSUB 1400:CLOSE 1,#2:KILL USERS$:NAME USERS.BAK$ AS USERS$:GOSUB 9400:RESUME 1200 13021 IF ERR=61 AND ERL=10240 THEN A$="Disk full -- restoring MESSAGES file.":GOSUB 1400:CLOSE 1,#2:KILL MESSAGES$:NAME MESSAGES.BAK$ AS MESSAGES$:GOSUB 135:RESUME 1200 13022 IF ERR=61 THEN GOSUB 1400:A$="<< Disk is full -- file operation abnormally terminated. >>":CR=2:GOSUB 1400:RESUME 1200 13030 IF ERL=1540 OR ERL=3720 OR ERL=20840 OR ERL=21290 OR ERL=21360 OR ERL=3734 THEN FOR EXX=1 TO 500:NEXT:IF INP(&H3FE)<128 THEN RESUME 13900 ELSE RESUME 13032 IF ERR<>71 THEN 13040 13034 A$="The SYSOP left the drive door open by mistake.":GOSUB 1400 13036 A$="The File Menu is not available today.":GOSUB 1400:RESUME 20020 13040 IF ERL=3530 THEN RESUME 3540 13050 IF ERL=3750 THEN RESUME 3720 13060 IF ERL=220 THEN RESUME 13062 IF (ERL=340 AND NOT BIT.8) THEN OUT &H3FB,&H3:RESUME 335 13065 IF ERL=340 THEN RESUME 345 13070 IF ERL=20620 OR ERL=21130 THEN OK=0:RESUME NEXT 13080 IF ERL=20220 OR ERL=10112 OR ERL=12005 THEN IF ERR=58 THEN OK=-1:RESUME NEXT ELSE RESUME NEXT 13090 IF ERL=20440 THEN IF ERR=53 THEN OK=-1:RESUME NEXT ELSE RESUME NEXT 13100 IF ERL=20450 THEN OK=0:RESUME NEXT 13105 IF ERL=6020 THEN RESUME 6080 13110 IF ERR=57 OR ERR=24 OR ERR=25 THEN FOR EXX=1 TO 500:NEXT:IF INP(&H3FE)<128 THEN RESUME 13900 ELSE IF LPRT THEN LPRINT "+++ Modem status is: "HEX$(EXX) 13115 IF ERR=5 THEN CLEAR:RUN 13120 IF ERL=5530 THEN RESUME 5530 13130 IF ERL<1200 THEN RESUME 13900 13140 A$="You have located a software bug.":GOSUB 1400 13150 A$="Please leave a comment or a msg for SYSOP that":GOSUB 1400 13160 A$="Error "+STR$(ERR)+" occured in Line "+STR$(ERL)+".":GOSUB 1400 13170 A$="Thank You...":GOSUB 1400:PRINT:RESUME 1200 13900 RUN 15000 'Hold system open for SYSOP next ------------ 15010 IF SYSOPNEXT THEN SYSOPNEXT=0:PRINT "Next caller gets system.":ELSE SYSOPNEXT=-1:PRINT "SYSOP gets system next." 15020 RETURN 20000 'File subsystem ------------------------------ 20010 GOSUB 1400:A$="Entering File Subsystem...":GOSUB 1400 20015 IF LOCAL GOTO 20020 ELSE GOSUB 1400:GOSUB 41000:A$="Time remaining = "+TR$+" min.":GOSUB 1400 20020 IF XPR THEN 20030 ELSE GOSUB 50200 20030 GOSUB 1400:A$="File Function <G,H,L,D,U,M,?>" 20040 CR=1:GOSUB 1500:IF Q=0 THEN 20015 20050 Z$=B$(1):GOSUB 5000:FF=INSTR("LDUMGH?",Z$) 20060 IF FF=0 THEN A$=FIRST$+" I don't understand "+B$(1)+".":GOSUB 1400:GOTO 20015 20070 ON FF GOSUB 20150,20180,20400,20090,20100,20110,20130 20080 GOTO 20015 20090 RETURN 20095 20095 RETURN 1200 20100 RETURN 10560 20110 'Help subdirectory --------------------------- 20120 FILE$=HELP05$:GOSUB 6000:RETURN 20130 '? subdirectory ------------------------------ 20140 FILE$=HELP06$:GOSUB 6000:RETURN 20150 'List option --------------------------------- 20155 IF INSTR(B$,";")>0 THEN STARTD=VAL(RIGHT$(B$,1)) ELSE STARTD=1 20160 A$="Files available for downloading..":CR=1:GOSUB 1400 20165 FOR X=STARTD TO LEN(FDEV$)-1:FILE$=MID$(FDEV$,X,1)+":"+DIR$:Z$=FILE$:CR=2:GOSUB 1400:GOSUB 52000:A$="Download disk has"+ACUM$:CR=2:GOSUB 1400:GOSUB 6000 20170 A$="End directory #"+STR$(X):IF X<LEN(FDEV$)-1 THEN A$=A$+". List more":GOSUB 1500:IF NO THEN RETURN 20175 NEXT:GOSUB 1400:RETURN 20180 'Download a file function -------------------------------- 20190 IF Q>1 THEN B=2:GOTO 20202 20200 A$="Enter full filename to download":GOSUB 1500:B=1:IF Q=0 THEN RETURN 20202 A=1:IF Q>B THEN A=VAL(B$(B+1)):IF A<1 THEN A=1 20205 FOR X=A TO LEN(FDEV$)-1 20210 FILE$=MID$(FDEV$,X,1)+":"+B$(B) 20220 OK=0:NAME FILE$ AS FILE$ 20225 IF OK THEN 20235 20230 NEXT:A$="File <"+B$(B)+"> was not found. Type L for directory.":CR=2:GOSUB 1400 20232 IF LPRT THEN LPRINT " File "+B$(B)+" was not found." 20233 GOTO 20020 20235 EXT$=RIGHT$(FILE$,4):IF EXT$=".EXE" OR EXT$=".exe" OR EXT$=".COM" OR EXT$=".com" THEN GOSUB 1400:A$="This is a binary file and requires XMODEM transfer...":GOSUB 1400 20240 A$="Download type <X>modem, <A>scii, <Q>uit":CR=1:GOSUB 1500 20250 IF Q=0 THEN 20240 ELSE Z$=B$(1):FT$=Z$:GOSUB 5000 20260 FF=INSTR("XAQ",Z$):IF FF=0 THEN 20240 20270 ON FF GOTO 20290,20340,20280: 20280 RETURN 20290 'Download using XMODEM -------------------------------------- 20300 OPEN "R",2,FILE$,128:GOSUB 20750 20305 IF NOT BIT.8 THEN GOSUB 1400:A$="Switching to N,8,1 for binary transfer. You do the same.":CR=2:GOSUB 1400 20310 A$="Ready to send. Enter <Ctrl-X> to abort transfer...":GOSUB 1400 20320 GOSUB 21300 20330 CLOSE 2 20335 C=2:A$="":GOSUB 1400:Y$=" downloaded ":GOSUB 50600:RETURN 20340 'Download using ASCII ------------------------------------------- 20350 DNLD=-1:OPEN "I",#2,FILE$:GOSUB 20750 20360 A$="Transfer can be suspended with <CTL-S>, aborted with <CTL-X>.":CR=2:GOSUB 1400 20370 A$="Ready to send. Open download file then enter <C/R> to start":CR=1:GOSUB 1500 20380 ABT$=CAN$:STI=-1:GOSUB 6030:ABT$=CHR$(11):CR=2:IF RET THEN A$="<*>Download aborted<*>":GOTO 20390 20381 A$=CHR$(26):GOSUB 1400 20382 IF NOT LOCAL THEN FOR II=1 TO 5:PRINT #3,CHR$(7):GOSUB 40000:NEXT II 20383 A$="<*>End of file<*>" 20385 GOSUB 1400:Y$=" downloaded ":GOSUB 50600 20390 RETURN 20400 'Upload file functions ----------------------------------------- 20410 IF Q=2 THEN B$(1)=B$(2):GOTO 20430 20420 CR=1:A$="Enter full name of file to be uploaded":GOSUB 1500:IF Q=0 THEN RETURN 20430 Z$=B$(1):GOSUB 5000 20435 FOR X=1 TO LEN(FDEV$) 20437 FILE$=MID$(FDEV$,X,1)+":"+Z$ 20440 OK=0:NAME FILE$ AS FILE$ 20450 IF NOT OK THEN 20460 20455 NEXT X 20460 IF NOT OK AND SYSOP THEN A$="File exists, overwrite or supersede":GOSUB 1500:IF YES THEN OK=-1 20465 IF OK THEN FILE$=RIGHT$(FDEV$,1)+":"+Z$:OPEN "R",2,FILE$,128 20470 IF NOT OK THEN CLOSE 2:A$="File <"+Z$+"> already exists. You must use a unique name.":CR=2:GOSUB 1400:GOTO 20420 20475 Z$=LEFT$(FILE$,2)+DIR$:CR=2:GOSUB 1400:GOSUB 52000:A$="Upload disk has"+ACUM$:CR=2:GOSUB 1400 20480 A$="Upload type <X>modem, <A>scii, <Q>uit":CR=1:GOSUB 1500 20490 IF Q=0 THEN 20480 ELSE Z$=B$(1):FT$=Z$:GOSUB 5000 20500 FF=INSTR("XAQ",Z$):IF FF=0 THEN 20480 20510 ON FF GOTO 20530,20560,20740:STOP 20520 ' 20530 'Upload using XMODEM ----------------------------------------- 20535 IF NOT BIT.8 THEN GOSUB 1400:A$="Switching to N,8,1 for binary transfer. You do the same, then start XMODEM.":CR=2:GOSUB 1400 20540 A$="Ready to receive. Enter <Ctrl-X> to abort transfer...":GOSUB 1400:GOSUB 50500 20550 OK=-1:GOSUB 20860:X#=0:IF OK THEN 20700 ELSE 20730 20560 'Upload using ASCII ---------------------------------------- 20570 A$="Terminate the transfer with a <CTL-K>.":CR=2:GOSUB 1400 20580 A$="Ready to receive file......":GOSUB 1400:OK=0:X=FALSE 20585 CLOSE 2:OPEN "O",2,FILE$:PRINT "<Esc> from SYSOP will abort." 20590 IF LOF(3)<128 THEN PRINT #3,CHR$(19);:X=TRUE 20600 WHILE NOT EOF(3) 20605 GOSUB 42000 20610 X$=INPUT$(LOC(3),3):IF INSTR(X$,CHR$(11)) THEN 20650 20620 OK=-1:PRINT #2,X$;:IF NOT OK THEN 20670 20630 WEND:GOSUB 42000:IF X THEN X=FALSE:PRINT #3,CHR$(17); 20640 IF INKEY$=ESC$ THEN 20660 ELSE 20590 20650 X=INSTR(X$,CHR$(11)):IF X<>1 THEN PRINT #2,LEFT$(X$,X-1) ELSE IF NOT OK THEN 20730 20660 A$="File upload complete.":GOSUB 1400:X#=128:GOTO 20700 20670 A$=CHR$(19)+"System error, transfer aborted, enter <CTL-K> to continue":GOSUB 1400:FOR X=1 TO 2000:NEXT:PRINT #3,CHR$(17); 20680 WHILE NOT EOF(3):X$=INPUT$(LOC(3),3):IF INSTR(X$,CHR$(11)) THEN 20730 20685 GOSUB 42000 20690 WEND:GOTO 20680 20700 X#=LOC(2)*128+X#:CLOSE 2:OPEN "A",2,LEFT$(FILE$,2)+DIR$:FILE$=MID$(FILE$,3) 20710 A$="Enter 40 character description of <"+FILE$+">":GOSUB 1400:GOSUB 1500:IF LEN(B$(1))>40 THEN 20710 20720 PRINT#2,USING "\ \#######, & - &";FILE$;X#;DATE$;B$(1):CLOSE 2:Y$=" >> uploaded << ":GOSUB 50600:RETURN 20730 A$="File upload abort. Partial file deleted from disk.":GOSUB 1400 20740 CLOSE 2:KILL FILE$:RETURN 20750 ' Print transfer time information ---------------------------- 20760 CNT#=FIX(LOF(2)/128):X#=LOF(2)/128:IF CNT#<>X# THEN X#=X#+1 20770 GOSUB 1400:A$="File size is"+STR$(INT(X#))+" blocks.":GOSUB 1400 20780 IF BPS=&H100 THEN X#=X#*139/45 ELSE IF BPS=-1 THEN X#=X#*139/120 ELSE X#=X#*139/30 20790 A$="Transfer time:"+STR$(INT(X#/60))+" minutes,"+STR$(X# MOD 60)+" seconds.":GOSUB 1400:GOSUB 50500 20800 RETURN 20810 'Get Character ---------------------------------------- 20820 GOSUB 42000:Y$="" 20830 FOR XA=1 TO 420 20840 IF NOT EOF(3) THEN Y$=INPUT$(LOC(3),3):RETURN 20850 NEXT XA:Y$="":RETURN 20860 'Receive With Xmodem Protocol ----------------------------------- 20870 IF PRT THEN PRINT:PRINT ">>> SYSOP, enter <Esc> to cause early termination. <<<" 20875 GOSUB 40000 20881 IF NOT BIT.8 THEN OUT &H3FB,3:GOSUB 21280 20900 X$="":SEC=1:FIELD 2,128 AS Z$ 20910 PRINT #3,NAK$; 20920 FOR XB=1 TO 10:Y$=INKEY$:IF Y$=ESC$ THEN 21270 ELSE GOSUB 20810 20930 IF LEFT$(Y$,1)=SOH$ THEN 21020 20940 IF LEFT$(Y$,1)=EOT$ THEN 21220 20950 IF LEFT$(Y$,1)=CAN$ THEN 21230 20960 IF Y$<>"" THEN GOSUB 21280:GOTO 20920 20970 NEXT XB 20980 PRINT #3,NAK$;:IF PRT THEN PRINT "Timeout" 20990 GOTO 20920 21000 GOSUB 20810 21010 IF Y$="" THEN PRINT "Timeout":GOTO 21040 21020 X$=X$+Y$ 21030 IF LEN(X$)<132 THEN 21000 21040 IF LEN(X$)=132 THEN 21090 21050 IF LEN(X$)>132 THEN 21180 21060 IF X$=EOT$ THEN 21220 21070 IF X$=CAN$ THEN 21230 21080 GOTO 21170 21090 IF SEC<>ASC(MID$(X$,2,1)) THEN 21200 21100 IF (SEC XOR 255)<>ASC(MID$(X$,3,1)) THEN 21210 21110 CALL CKSM(X$,CK):IF CK<>ASC(MID$(X$,132,1)) THEN 21190 21120 PRINT #3,ACK$; 21130 LSET Z$=MID$(X$,4):PUT 2:IF NOT OK THEN 21230 21140 IF PRT THEN PRINT "Received #"SEC"("RIGHT$("0"+HEX$(SEC),2)")" 21145 SEC=255 AND (SEC+1) 21150 X$="":CK=0:GOTO 20920 21160 IF PRT THEN PRINT SEC"("RIGHT$("0"+HEX$(SEC),2)")" 21165 PRINT #3,NAK$;:GOTO 21150 21170 IF PRT THEN PRINT "Short Block in #"; 21175 GOTO 21160 21180 IF PRT THEN PRINT "Long Block in #"; 21185 GOTO 21160 21190 IF PRT THEN PRINT "Checksum Error in #"; 21195 GOTO 21160 21200 IF PRT THEN PRINT "Block # Error in #"; 21205 GOTO 21160 21210 IF PRT THEN PRINT "Complement Error in #"; 21215 GOTO 21160 21220 IF PRT THEN PRINT "File Closed." 21225 PRINT #3,ACK$;:GOTO 21250 21230 IF PRT THEN PRINT "Transfer Aborted." 21240 OK=FALSE:PRINT #3,CAN$;CAN$; 21250 ' end 21260 IF NOT BIT.8 THEN GOSUB 21280:A$="Enter C/R after switching to E,7,1":GOSUB 1400:GOSUB 40000:OUT &H3FB,26:GOSUB 1500 21265 RETURN 21270 IF PRT THEN PRINT "Transfer aborted by <Esc> keyin" 21275 GOSUB 21280:GOTO 21240 21280 'Purge Buffer ----------------------------------- 21290 WHILE NOT EOF(3):DUMMY$=INPUT$(LOC(3),3):WEND:RETURN 21300 'Send with Xmodem Protocol --------------------------------------- 21310 IF PRT THEN PRINT:PRINT ">>> SYSOP, enter <Esc> to cause early termination. <<<" 21320 IF NOT BIT.8 THEN GOSUB 40000:OUT &H3FB,3 21330 SEC=0:GOSUB 21280 21340 FIELD #2,128 AS X$ 21350 WHILE NOT EOF(3) 21355 ' 21360 Y$=INPUT$(1,3) 21370 IF Y$=CAN$ THEN 21560 21380 IF Y$=NAK$ THEN 21480 21390 WEND:GOSUB 42000:Y$=INKEY$:IF Y$=ESC$ THEN 21540 ELSE 21350 21400 ' 21410 WHILE NOT EOF (3) 21415 ' 21420 Y$=INPUT$(1,3) 21430 IF Y$=ACK$ THEN 21480 21440 IF Y$<>NAK$ THEN 21450:IF PRT THEN PRINT "Re"; 21445 GOTO 21510 21450 IF Y$=CAN$ THEN 21560 21460 WEND:GOSUB 42000:Y$=INKEY$:IF Y$=ESC$ THEN 21540 ELSE 21410 21470 ' 21480 IF LOC(2)<LOF(2)/128 THEN 21490 21482 IF PRT THEN PRINT "End of file" 21485 GOTO 21530 21490 GET 2:SEC=255 AND (SEC+1) 21500 A$=SOH$+CHR$(SEC)+CHR$(SEC XOR 255)+X$:CALL CKSM(A$,CK):A$=A$+CHR$(CK) 21510 IF PRT THEN PRINT "Send #"SEC"("RIGHT$("0"+HEX$(SEC),2)")" 21520 PRINT #3,A$;:GOSUB 21280:GOTO 21410 21530 PRINT #3,EOT$;:FOR X=1 TO 10:GOSUB 20810:IF Y$=ACK$ THEN 21570 ELSE Y$=INKEY$:IF Y$<>ESC$ THEN NEXT:GOSUB 21280:GOTO 21530 21540 IF PRT THEN PRINT "Transfer aborted by <Esc> keyin" 21545 PRINT #3,CAN$;CAN$;:GOTO 21570 21550 IF PRT THEN PRINT "Transmission Ended." 21555 PRINT #3,EOT$;:GOTO 21570 21560 IF PRT THEN PRINT "Transmission Aborted by Receiver" 21570 ' 21580 IF NOT BIT.8 THEN GOSUB 21280:A$="Enter C/R after switching to E,7,1":GOSUB 1400:GOSUB 40000:OUT &H3FB,26:GOSUB 1500 21585 RETURN 21590 GOTO 21550 21595 ' Baud switch------------------------ 21600 RESTORE 21610:BAUDS=VARPTR(#3)+188:FOR X=0 TO 68:READ Y:POKE BAUDS+X,Y:NEXT:CKSM=BAUDS+2:RETURN 21610 DATA 235,2,235,33,85,139,236,250,186,251,3,236,138,216,12,128 21620 DATA 238,139,118,6,139,4,186,248,3,239,186,251,3,138,195,238 21630 DATA 251,93,202,2,0,85,139,236,139,118,8,70,184,0,0,185 21640 DATA 128,0,139,52,131,198,3,2,4,70,226,251,139,126,6,137 21650 DATA 5,93,202,4,0 30000 'Force Chat Mode [ KEY 10 ] --------------- 30010 ' B$=SYSOP'S CHARACTER, C$=USER'S CHARACTER 30020 A$=CHR$(12)+"SYSOP is active....You are now in CHAT mode...":CR=2:GOSUB 1400 30025 GOSUB 50500:A$="Hello, this is "+NFIR$+" "+NLAS$+". Sorry to break in but....":CR=2:GOSUB 1400 30030 GOSUB 4770:RETURN 31000 ' Return to System [ KEY 1 ] --------------- 31010 ON ERROR GOTO 0:CLS:SYSTEM 32000 ' Exit into BASIC [ KEY 2 ] 32010 CLS:KEY 1,"LIST ":KEY 2,"RUN"+CHR$(13):KEY 3,"LOAD"+STRING$(1,34):KEY 4,"SAVE"+STRING$(1,34) 32020 KEY ON:CLEAR:END:RETURN 33000 ' Toggle Line Printer [ KEY 3 ] ------------------ 33010 LPRT=NOT LPRT:IF (PRT AND LPRT) THEN PRINT "Line Printer ON." ELSE PRINT "Line Printer OFF." 33020 RETURN 33040 ' 33050 ANNOY=NOT ANNOY:IF (PRT AND ANNOY) THEN PRINT "Page bell is ON." ELSE PRINT "Page bell is temporarily OFF. Will reset to ON with next caller." 33060 RETURN 39000 ' Toggle Snoop on [ KEY 9 ] ------------------------- 39010 IF PRT THEN PRT=FALSE:LOCATE ,,0:CLS:RETURN 39020 LOCATE 25,1,0:PRINT SPACE$(79-(LEN(NAM$)+10));NAM$" "TI$;:IF NAM$="" THEN LOCATE 25,45,0:PRINT"No one has been on since"; 39030 PRT=TRUE:LOCATE 25,1,1:PRINT"SNOOP ON... FREE SPACE=" FRE("");:LOCATE 23,1,1 39040 LOCATE 24,35:PRINT"--------------------------------------------" 39050 LOCATE 24,35:PRINT"| [F1] - SYSTEM | [F2] - BASICA |" 39060 LOCATE 24,35:PRINT"| [F3] - PRINT TOGGLE | [F4] - PAGE TOGGLE |" 39070 LOCATE 24,35:PRINT"| [F5] - | [F6] - |" 39080 LOCATE 24,35:PRINT"| [F7] - SYSOP ON NEXT| [F8] - |" ' 39090 LOCATE 24,35:PRINT"| [F9] - SNOOP TOGGLE | [F10]- FORCE CHAT |" 39100 LOCATE 24,35:PRINT"--------------------------------------------" 39110 RETURN 40000 '3 sec time delay for display --------------------- 40010 FOR JJ=1 TO 40:SOUND 32767,1:NEXT JJ 40020 RETURN 41000 ' Time remaining ---------------------- 41005 IF TIMER>TI! THEN TIME.ON.SYS!=TIMER-TI! ELSE TIME.ON.SYS!=TIMER+86400!-TI! 41010 TR!=TIME.MAX!-TIME.ON.SYS!:IF TR!<0 THEN 10560 41020 TR$=STR$(INT(TR!/60)):RETURN 42000 ' Check for COMM port carrier detect ---------------------- 42005 IF LOCAL THEN RETURN 42010 IF INP(&H3FE)<128 THEN RUN 42020 RETURN 50000 'non-recoverable error or ERROR.MAX exceeded ------------------ 50005 A$="A Fatal error has occurred...System going down now":GOSUB 1400:RUN 50010 CLOSE : RUN 50020 ' 50100 'Main menu ------------------------------------------------- 50105 A$=" ":GOSUB 1400 50110 A$=" ===================== RBBS-PC MAIN MENU ====================":GOSUB 1400 50120 A$=" ":GOSUB 1400 50130 A$=" B)ulletins C)omment E)nter message F)iles menu":GOSUB 1400 50140 A$=" G)oodbye H)elp K)ill a message L)ine feeds":GOSUB 1400 50150 A$=" M)sg margin N)ew baud O)perator P)rompt sound":GOSUB 1400 50160 A$=" PL)age length PW)assword Q)uick scan R)ead messages":GOSUB 1400 50170 A$=" S)can msgs T)ime U)serslog W)elcome":GOSUB 1400 50175 A$=" X)pert on/off #)statistics ?)Functions !)Personal mail":GOSUB 1400 50180 RETURN 50190 ' 50200 'File menu ------------------------------------------- 50210 A$=" ":GOSUB 1400 50220 A$=" ===================== RBBS-PC FILE MENU ====================":GOSUB 1400 50230 A$=" ":GOSUB 1400 50240 A$=" G)oodbye H)elp D)ownload a file":GOSUB 1400 50250 A$=" L)ist files M)ain menu U)pload a file":GOSUB 1400 50260 ' 50270 A$=" ?) Xfer Info":GOSUB 1400 50280 RETURN 50300 ' 50305 ' 50310 ' 50320 ' 50400 'Message menu ---------------------------------------- 50410 A$=" ":GOSUB 1400 50440 A$="<A>bort, <C>ontinue, <D>elete, <E>dit, <I>nsert, <L>ist, <M>argin, <S>ave":GOSUB 1400 50480 RETURN 50500 'One sec time delay ---------------------------- 50510 FOR JJ=1 TO 18:SOUND 32700,1:NEXT:RETURN 50600 ' record the file downloaded/upload ---------------------------------- 50610 GOSUB 480:Y$=" "+FILE$+Y$+"at "+TIM$+" using "+FT$ 50612 CLOSE 2:OPEN "A",2,CALLERS$:PRINT #2,Y$:CLOSE 2 50615 IF LPRT THEN LPRINT Y$ 50620 RETURN 52000 'Get info on free space from screen--------------------------- 52010 ACUM$="":CLS:FILES Z$:CC=CSRLIN-2 52020 FOR RICH=1 TO 25:T=SCREEN(CC,RICH):IF T>122 THEN 52023 52022 ACUM$=ACUM$+CHR$(T) 52023 NEXT RICH:IF NOT PRT THEN CLS 52030 RETURN 63000 ' - *** END OF PROGRAM ***